home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 025a / gsdb25.zip / GS_PICK.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-01  |  7KB  |  224 lines
  1. UNIT GS_Pick;
  2.  
  3. INTERFACE
  4.  
  5. USES
  6.    Crt,
  7.    Dos,
  8.    GS_Scrn,
  9.    GS_Error,
  10.    GS_KeyI,
  11.    GS_Sort,
  12.    GS_Strng,
  13.    GS_Winfc;
  14.  
  15. function GS_Pick_Row_Item (var tabl; clth : integer;
  16.                            icnt, sitem : longint): longint;
  17. function GS_Pick_Line_Item (var tabl; clth : integer;
  18.                             icnt, sitem : longint) : longint;
  19. procedure GS_Pick_Item_Sort (var tabl; clth : integer;
  20.                              icnt : longint; ascnd : boolean);
  21.  
  22. {tabl = starting location of the array}
  23. {clth = length of entry (for a string, it is length(string)+1 to include the}
  24. {        length byte.  Recommend passing sizeof(entry) for accuracy)}
  25. {icnt = number of entries}
  26. {ascnd = boolean value for sort direction.  True for ascending sort; false for
  27.          descending.
  28. {sitem = entry number to highlight.  Can be any number form 1 to icnt.  This}
  29. {        can be used to "remember" the last item selected.  for example:    }
  30. {                                                                           }
  31. {        i := 1;                                                            }
  32. {        while i <> 0 do                                                    }
  33. {        begin                                                              }
  34. {           i := GS_Pick_Line_Item(dataarray,sizeof(dataentry),25,i);       }
  35. {           case i of                                                       }
  36. {                    .                                                      }
  37. {                    .                                                      }
  38. {                    .                                                      }
  39. {           end;                                                            }
  40. {        end;                                                               }
  41.  
  42.  
  43.  
  44. implementation
  45.  
  46. var
  47.    Sort_Tab     : GS_Sort_Objt;
  48.    txc,
  49.    bgc,
  50.    fgc,
  51.    txh,
  52.    bgh           : byte;
  53.  
  54. procedure FindColors;
  55. begin
  56.    GS_Wind_GetColors(txc,bgc,fgc,txh,bgh);
  57. end;
  58.  
  59. function GS_Pick_Row_Item (var tabl; clth : integer;
  60.                            icnt, sitem : longint): longint;
  61. var
  62.    ci, cw, ct, l : longint;
  63.    cj, cis,
  64.    cih           : longint;
  65.    lins,
  66.    wdth, fl,
  67.    x, y, k       : integer;
  68.    chrr          : char;
  69.    strng         : string[255];
  70.    z             : array [0..maxint-1] of char absolute tabl;
  71. begin
  72.    GS_KeyI_Fuc := false;
  73.    GS_Scrn_HideCursor;
  74.    FindColors;
  75.    lins := (hi(windmax)) - (hi(windmin));
  76.    wdth := ((lo(windmax)) - (lo(windmin))) + 1;
  77.    l := icnt;
  78.    ci := sitem div lins;
  79.    ci := ci * lins;
  80.    fl := sitem;
  81.    cih := 0;
  82.    cis := 1;
  83.    repeat
  84.       if ci + (lins-1) > l then ci := l - (lins-1);
  85.       if ci < 1 then ci := 1;
  86.       if (not GS_KeyI_Fuc) and (fl <= icnt) then cis := (fl - ci)+1;
  87.       cj := ci;
  88.       if ci <> cih then
  89.       begin
  90.          k := 1;
  91.          cih := ci;
  92.          while cj < ci+lins do
  93.          begin
  94.             if cj <= l then
  95.             begin
  96.                y := k;
  97.                x := 2;
  98.                gotoxy(x,y);
  99.                move(z[((cj-1)*(clth))],strng[0],clth);
  100.                fillchar(strng[length(strng)+1],clth-length(strng),' ');
  101.                strng[0] := chr(clth);
  102.                write(strng);
  103.                inc(cj);
  104.                inc(k);
  105.             end else cj := 9999;
  106.          end;
  107.          gotoxy(1,lins+1);
  108.          if cj-1 < l then write('':(wdth-10) div 2,'-- more --')
  109.             else write('':wdth-1);
  110.       end;
  111.       GS_Scrn_Put_Atr(1,cis,wdth,cis,txh,bgh);
  112.       chrr := GS_KeyI_GetKey;
  113.       GS_Scrn_Put_Atr(1,cis,wdth,cis,txc,bgc);
  114.       if GS_KeyI_Fuc then
  115.       begin
  116.          case chrr of
  117.             Kbd_Home : begin
  118.                         ci := 1;
  119.                         cis := 1;
  120.                      end;
  121.             Kbd_End  : begin
  122.                           ci := l;
  123.                           cis := lins;
  124.                        end;
  125.             Kbd_PgUp : begin
  126.                           ci := ci - lins;
  127.                        end;
  128.             Kbd_PgDn : begin
  129.                           ci := ci + lins;
  130.                        end;
  131.             Kbd_UpAr : begin
  132.                           if cis = 1 then ci := ci - 1 else cis := cis - 1;
  133.                        end;
  134.             Kbd_DnAr : begin
  135.                           if cis = lins then ci := ci + 1 else cis := cis + 1;
  136.                        end;
  137.             else SoundBell(BeepTime, BeepFreq);
  138.          end;
  139.          if cis > l then cis := l;
  140.       end else
  141.       begin
  142.          case chrr of
  143.             Kbd_Ret :  GS_Pick_Row_Item := ci+cis-1;
  144.             Kbd_Esc :  GS_Pick_Row_Item := 0;
  145.             else
  146.                begin
  147.                   fl := 1;
  148.                   while (z[((fl-1)*(clth))+1] <> chrr) and
  149.                         (z[((fl-1)*(clth))+1] <> upcase(chrr)) and
  150.                         (fl <= icnt) do inc(fl);
  151.                   if fl <= icnt then ci := fl
  152.                      else SoundBell(BeepTime, BeepFreq);
  153.                end;
  154.          end;
  155.       end;
  156.    until chrr in [Kbd_Ret,Kbd_Esc];
  157.    GS_Scrn_ShowCursor;
  158. end;
  159.  
  160. function GS_Pick_Line_Item (var tabl; clth : integer;
  161.                             icnt, sitem : longint) : longint;
  162. var
  163.    ci,
  164.    x, y, k, l    : integer;
  165.    chrr          : char;
  166.    strng         : string[255];
  167.    z             : array [0..maxint-1] of char absolute tabl;
  168. begin
  169.    GS_Scrn_HideCursor;
  170.    FindColors;
  171.    l := icnt;
  172.    y := 1;
  173.    ci := succ(pred(sitem)*clth);
  174.    if ci > l*clth then ci := ((l-1)*clth)+1;
  175.    if ci < 1 then ci := 1;
  176.    repeat
  177.       k := 1;
  178.       while k <= l do
  179.       begin
  180.          x := ((k-1) * clth)+1;
  181.          gotoxy(x,y);
  182.          move(z[((k-1)*(clth))],strng[0],clth);
  183.          if length(strng) > pred(clth) then
  184.             ShowError(851,'Error in GS_Pick_Line_Item Length');
  185.          fillchar(strng[length(strng)+1],clth-length(strng),' ');
  186.          strng[0] := chr(pred(clth));
  187.          write(strng);
  188.          inc(k);
  189.       end;
  190.       GS_Scrn_Put_Atr(ci,y,ci+clth-1,y,txh,bgh);
  191.       chrr := GS_KeyI_GetKey;
  192.       GS_Scrn_Put_Atr(ci,y,ci+clth-1,y,txc,bgc);
  193.       if GS_KeyI_Fuc then
  194.       begin
  195.          case chrr of
  196.             Kbd_Home :  ci := 1;
  197.             Kbd_LfAr :  ci := ci - clth;
  198.             Kbd_RtAr :  ci := ci + clth;
  199.             Kbd_End  :  ci := ((l-1) * clth) + 1;
  200.          end;
  201.          if ci > l*clth then ci := 1;
  202.          if ci < 1 then ci := ((l-1)*clth)+1;
  203.       end;
  204.    until chrr in [Kbd_Ret,Kbd_Esc];
  205.    if chrr = Kbd_Ret then
  206.    begin
  207.       GS_Pick_Line_Item := (ci div clth) + 1 ;
  208.    end else GS_Pick_Line_Item := 0;
  209.    GS_Scrn_ShowCursor;
  210. end;
  211.  
  212. procedure GS_Pick_Item_Sort (var tabl; clth : integer;
  213.                              icnt : longint; ascnd : boolean);
  214. begin
  215.    if icnt > 1 then
  216.    begin
  217.       Sort_Tab.SortDir(ascnd);
  218.       Sort_Tab.Sort(tabl,clth,icnt);
  219.    end;
  220. end;
  221.  
  222. begin
  223.    Sort_Tab.InitSort(true);           {Init ascending sort object)}
  224. end.